#!/usr/local/bin/perl
# Yen-Ming Lee <leeym@leeym.com>

use Cache::FileCache;
use Config::IniFiles;
use Cwd 'abs_path';
use Data::Dumper;
use Digest::MD5 qw(md5_hex);
use Encode qw(encode_utf8 decode_utf8);
use Fcntl ':mode';
use File::Basename;
use FindBin qw($Script);
use Fuse;
use Getopt::Long;
use Net::Amazon::S3;
use POSIX;
use Sys::Syslog;
use Time::HiRes;
use strict;

my $debug = 0;
my $cache = Cache::FileCache->new(
  {
    'namespace'          => 'jungledisk',
    'cache_root'         => $ENV{'HOME'} . '/.cache',
    'default_expires_in' => 60
  }
);

my $pid   = 0;
my $reset = 0;
my $s3cfg = $ENV{'HOME'} . '/.s3cfg';
my $access_key;
my $secret_key;

openlog($Script, 'pid', 'local0');
syslog('notice', "$Script openlog");

# http://aws.amazon.com/s3/pricing/
my %B;    # Bucket
my %T;    # Token
my %P;    # Path

END
{
  if (!$pid)
  {
    map { syslog('info', "B: $_ => " . $B{$_}); } (keys %B);
    map { syslog('info', "T: $_ => " . $T{$_}); } (keys %T);
    map { my @P = keys %{ $P{$_} }; syslog('info', "P: $_ => @P"); } (keys %P);
    syslog('notice', "$Script closelog");
    closelog();
  }
}

my @OPT;
GetOptions('o=s' => \@OPT);
foreach my $opt (@OPT)
{
  $access_key = $1 if ($opt =~ m{^access_key=(.+)$});
  $secret_key = $1 if ($opt =~ m{^secret_key=(.+)$});
}

# s3cmd compatible configuration file
# http://s3tools.logix.cz/s3cmd
my %cfg;
tie %cfg, 'Config::IniFiles';
if (-s $s3cfg)
{
  tied(%cfg)->SetFileName($s3cfg);
  tied(%cfg)->ReadConfig || die @Config::IniFiles::errors;
}
if (!$access_key || !$secret_key)
{
  $access_key = $cfg{'default'}{'access_key'};
  $secret_key = $cfg{'default'}{'secret_key'};
}

while (!$access_key || !$secret_key)
{
  $reset = 1;
  print 'Print input your access key: ';
  chomp($access_key = <STDIN>);
  print 'Print input your secret key: ';
  chomp($secret_key = <STDIN>);
}

if ($reset)
{
  $cfg{'default'}{'access_key'} = $access_key;
  $cfg{'default'}{'secret_key'} = $secret_key;
  tied(%cfg)->WriteConfig($s3cfg) || die $!;
}

my $s3 = Net::Amazon::S3->new(
  {
    'aws_access_key_id'     => $access_key,
    'aws_secret_access_key' => $secret_key
  }
);

my $bucketname = shift;
my $mountpoint = abs_path(shift);

die "Usage: $Script bucketname mountpoint" if !$bucketname || !-d $mountpoint;
my @S = stat($mountpoint);

my $cachedir = $ENV{'HOME'} . '/.jungledisk/cache';
mkdir($cachedir) if !-d $cachedir;
die "$Script: can't mkdir $cachedir" if !-d $cachedir;

my $uid         = int($<);
my $gid         = (getpwuid($<))[3];
my $_bucketname = sprintf('jd2-%s-us', md5_hex($access_key));

syslog('debug', "Bucketname: s3://$_bucketname/$bucketname");

my $bucket;
foreach my $_bucket (@{ $s3->buckets->{'buckets'} })
{
  next if ($_bucket->{'bucket'} ne $_bucketname);
  $bucket = $_bucket;
  last;
}
if (!$bucket)
{
  syslog('notice', "bucket V2 not found, create $_bucketname");
  $bucket = $s3->add_bucket({ bucket => $_bucketname }) or die $s3->errstr;
}

# fork into background
_reset();
$pid = fork;
exit if $pid;

Fuse::main(
  'debug'       => $debug,
  'mountpoint'  => $mountpoint,
  'mountopts'   => '',
  'threaded'    => 0,                         # not tested under threaded perl
  'getattr'     => 'main::jd2_getattr',
  'readlink'    => 'main::jd2_readlink',
  'getdir'      => 'main::jd2_getdir',
  'mknod'       => 'main::jd2_mknod',
  'mkdir'       => 'main::jd2_mkdir',
  'unlink'      => 'main::jd2_unlink',
  'rmdir'       => 'main::jd2_rmdir',
  'symlink'     => 'main::jd2_symlink',
  'rename'      => 'main::jd2_rename',
  'link'        => 'main::jd2_link',          # do not support hardlink
  'chmod'       => 'main::jd2_chmod',
  'chown'       => 'main::jd2_chown',         # owner is the one run $Script
  'truncate'    => 'main::jd2_truncate',
  'utime'       => 'main::jd2_utime',
  'open'        => 'main::jd2_open',
  'read'        => 'main::jd2_read',
  'write'       => 'main::jd2_write',
  'statfs'      => 'main::jd2_statfs',
  'flush'       => 'main::jd2_flush',
  'release'     => 'main::jd2_release',
  'fsync'       => 'main::jd2_fsync',
  'setxattr'    => 'main::jd2_setxattr',
  'getxattr'    => 'main::jd2_getxattr',
  'listxattr'   => 'main::jd2_listxattr',
  'removexattr' => 'main::jd2_removexattr',
);

sub jd2_getattr
{
  my $path = shift;
  syslog('info', "jd2_getattr($path)");
  my @s;
  if ($path eq '/')
  {
    @s = @S;
  }
  else
  {
    return if !_prefix($path);    # No such file or directory
    my $key = _attrkey($path);
    return -EIO() if !$key;
    my @KEY  = split('/', $key);
    my $type = $KEY[3];
    my $size = ($type eq 'dir') ? 512 : $KEY[5];
    my $attr = $KEY[-1];
    my %ATTR = split('-', $attr);
    my $dev  = 85;                                 # device number of filesystem
    my $ino  = 0;                                  # inode number
    my $mode  = 0;                     # file mode  (type and permissions)
    my $nlink = _nlink($path);         # number of (hard) links to the file
    my $rdev  = 0;                     # the device identifier
    my $atime = sprintf('%d', time);
    my $mtime = sprintf('%d', $ATTR{'mtime'} || time);
    my $ctime = sprintf('%d', $ATTR{'ctime'} || time);
    my $bsize = 16384;
    my $blks  = $size ? 4 : 0;
    $mode = ($type eq 'file' ? 0644 : 0755);
    $mode = $ATTR{'mode'} if $ATTR{'mode'};
    $mode = ($mode | S_IFREG) if ($type eq 'file');
    $mode = ($mode | S_IFDIR) if ($type eq 'dir');
    $mode = ($mode | S_IFLNK) if ($type eq 'symlink');
    @s    = (
      $dev,  $ino,   $mode,  $nlink, $uid,   $gid, $rdev,
      $size, $atime, $mtime, $ctime, $bsize, $blks
    );
  }
  syslog('debug', "\t\t@s");
  return @s;
}

sub _get_key
{
  my $key = shift;

  #syslog('debug', "\t_get_key($key)");
  my $cache_key = "get_key:$key";
  if ($cache)
  {
    my $cached = $cache->get($cache_key);
    return $cached if $cached;
  }
  my $got = bucket_get_key($key);
  $cache->set($cache_key, $got) if $cache;
  return $got;
}

sub _list_all
{
  my $prefix = shift;
  syslog('info', "\t\t_list_all(s3://$_bucketname/$prefix)");
  return if !$prefix;
  my $cache_key = "list_all:$prefix";
  if ($cache)
  {
    my $cached = $cache->get($cache_key);
    return $cached if $cached;
  }
  my $got = bucket_list_all($prefix);
  $cache->set($cache_key, $got) if $cache;
  return $got;
}

sub _prefix
{
  my $path  = shift;
  my $dir   = shift;
  my $token = _token($path);
  return if !$token;
  my $prefix;
  if ($path eq '/' || $dir)
  {
    $prefix = sprintf('%s/%s', $bucketname, $token);
  }
  else
  {
    my $parent = _token(dirname($path));
    return if !$parent;
    $prefix = sprintf('%s/%s/%s', $bucketname, $parent, $token);
  }

  #syslog('info', "\t_prefix($path) => $prefix");
  return $prefix;
}

sub jd2_readlink
{
  my $path = shift;
  syslog('info', "jd2_readlink($path)");
  return _read($path);
}

sub jd2_getdir
{
  my $path = shift;
  syslog('info', "jd2_getdir($path)");
  return _getdir($path);
}

sub _token
{
  my $path  = shift;
  my $token = shift;
  $path = '/' if !$path;
  $path =~ s{^//}{/};
  $token = 'ROOT' if ($path eq '/' && !$token);
  if ($path && length($token))
  {
    $T{$path} = $token;
    $P{$token}{$path} = 1;
  }
  _getdir(dirname($path)) if !$T{$path};
  return $T{$path};
}

sub _getdir
{
  my $path = shift;
  my $prefix = _prefix($path, 1);
  return if !$prefix;
  my $keys = _list_all($prefix)->{'keys'};
  my %K;
  foreach my $_key (@$keys)
  {
    my $key = $_key->{'key'};
    my ($d1, $parent, $child, $type, $name, $attr) = split('/', $key);
    $name = encode_utf8($name);
    _token($path,         $parent);
    _token("$path/$name", $child);
    $K{$name} = 1;
  }
  my @E = ('.', (sort keys %K), 0);
  syslog('info', "\t_getdir($path) => '" . join("', '", @E) . "'");
  return @E;
}

sub jd2_mknod
{
  my $path = shift;
  my $mode = shift;
  my $dev  = shift;
  syslog('info', "jd2_mknod($path, $mode, $dev)");
  return _mknod($path, 'file');
}

sub jd2_mkdir
{
  my $path = shift;
  my $mode = shift;
  syslog('info', "jd2_mkdir($path, $mode)");
  return _mknod($path, 'dir');
}

sub _mknod
{
  my $path  = shift;
  my $type  = shift;
  my $token = shift || md5_hex(Time::HiRes::time);
  $path = "/$path" if $path !~ m{^/};
  syslog('info', "\t_mknod($path, $type)");
  $path = decode_utf8($path);
  my $dirname  = encode_utf8(dirname($path));
  my $basename = basename($path);
  my $parent   = _token($dirname);
  my $mode     = ($type eq 'dir' ? 0755 : 0644);
  my %ATTR     = (
    'mtime' => int(time()),
    'ctime' => int(time()),
    'wattr' => 0,
    'mode'  => $mode,
  );

  my $key = "$bucketname/$parent/$token/$type/$basename/";

  if ($type eq 'dir')
  {

    # append nothing
  }
  elsif ($type eq 'file')
  {
    $key .= '0/0/';
  }
  elsif ($type eq 'symlink')
  {
    $key .= length($basename) . '/';
  }
  else
  {
    return -EOPNOTSUPP();
  }
  $key .= join('-', %ATTR);

  bucket_add_key($key);
  _reset($path);
  return 0;
}

sub _reset
{
  my $path = shift;
  syslog('info', "\t_reset($path)");
  $cache->clear() if $cache;
  %T = ();
  %P = ();
}

sub jd2_unlink
{
  my $path = shift;
  syslog('info', "jd2_unlink($path)");
  return _unlink($path);
}

sub jd2_rmdir
{
  my $path = shift;
  syslog('info', "jd2_rmdir($path)");
  my @getdir = _getdir($path);
  return -ENOTEMPTY() if scalar(@getdir) > 2;
  return -EIO() if scalar(@getdir) < 2;    # '.' and 0
  return _unlink($path);
}

sub _unlink
{
  my $path = shift;
  syslog('info', "\t_unlink($path)");
  my $key = _attrkey($path);
  return -EIO() if !$key;
  bucket_delete_key($key) || return $!;
  my $token = _token($path);
  delete($P{$token}{$path});
  bucket_delete_key(_remote($path)) if _nlink($path) == 0;
  _reset($path);
  return 0;
}

sub jd2_symlink
{
  my $path = shift;
  my $dest = shift;
  syslog('info', "jd2_symlink($path, $dest)");
  _mknod($dest, 'symlink');
  _write($dest, $path);
  _fsync($dest, 1);
}

sub jd2_rename
{
  my $path = shift;
  my $dest = shift;
  syslog('info', "jd2_rename($path, $dest)");
  return _clone($path, $dest, 1);
}

sub jd2_link
{
  my $path = shift;
  my $dest = shift;
  syslog('info', "jd2_link($path, $dest)");
  return -EOPNOTSUPP();
  return _clone($path, $dest);
}

sub _clone
{
  my $path = shift;
  my $dest = shift;
  my $del  = shift || 0;
  syslog('info', "\t_clone($path, $dest, $del)");
  my $old = _attrkey($path);
  return -EIO() if !$old;
  my @KEY = split('/', $old);
  $KEY[0] = $bucketname;
  $KEY[1] = _token(dirname($dest));
  $KEY[2] = _token($path);
  $KEY[4] = decode_utf8(basename($dest));
  my $new = join('/', @KEY);
  bucket_add_key($new);
  bucket_delete_key($old) if $del;
  _reset($path);
  _reset($dest);
  return 0;
}

sub jd2_chmod
{
  my $path = shift;
  my $mode = shift;
  syslog('info', "jd2_chmod($path, $mode)");
  return _attr($path, { 'mode' => $mode });
}

sub jd2_chown
{
  return -EOPNOTSUPP();
}

sub jd2_truncate
{
  my $path   = shift;
  my $offset = shift;
  syslog('info', "jd2_truncate($path, $offset)");
  _write($path, substr(_read($path), 0, $offset));
  _fsync($path, 1);
  _reset($path);
  return 0;
}

sub jd2_utime
{
  my $path  = shift;
  my $ctime = shift;
  my $mtime = shift;
  syslog('info', "jd2_utime($path, $ctime, $mtime)");
  return _attr($path, { 'ctime' => $ctime, 'mtime' => $mtime });
}

sub _attr
{
  my $path  = shift;
  my $_attr = shift;
  my %_ATTR = %$_attr;
  my $old   = _attrkey($path);
  return -EIO() if !$old;

  my @KEY  = split('/', $old);
  my $attr = pop(@KEY);
  my %ATTR = split(/-/, $attr);

  map { $ATTR{$_} = $_ATTR{$_}; } (keys %_ATTR);
  push(@KEY, join('-', %ATTR));
  my $new = join('/', @KEY);

  bucket_rename_key($old, $new);
  _reset($path);
  return 0;
}

sub _resize
{
  my $path = shift;
  my $size = shift;
  syslog('info', "\t_resize($path, $size)");
  my $prefix = _prefix($path);
  return if !$prefix;
  my $keys = _list_all($prefix)->{'keys'};
  return -EIO() if !scalar(@$keys);

  foreach my $_key (@$keys)
  {
    my $old = $_key->{'key'};
    my @KEY = split('/', $old);
    return 0 if $KEY[3] ne 'file';
    return 0 if $KEY[5] == $size;
    $KEY[5] = $size;
    my $new = join('/', @KEY);
    bucket_rename_key($old, $new);
  }
  _reset($path);
  return 0;
}

sub jd2_open
{
  my $path = shift;
  my $flag = shift;
  syslog('info', "jd2_open($path, $flag)");
  return 0;
}

sub jd2_read
{
  my $path   = shift;
  my $size   = shift;
  my $offset = shift;
  syslog('info', "jd2_read($path, $offset, $size)");
  return substr(_read($path), $offset, $size);
}

sub _remote
{
  my $path = shift;
  my $remote = sprintf("$bucketname/FILES/%s/%d", _token($path), 0);
  syslog('debug', "\t\t_remote($path) => $remote");
  return $remote;
}

sub _local
{
  my $path  = shift;
  my $local = $cachedir . '/' . _token($path);
  syslog('debug', "\t\t_local($path) => $local");
  return $local;
}

sub _read
{
  my $path = shift;
  syslog('debug', "\t_read($path)");
  my $token = _remote($path);
  my $key   = _get_key($token);
  return _decrypt($key);
}

sub jd2_write
{
  my $path   = shift;
  my $buffer = shift;
  my $offset = shift;
  syslog('info', "jd2_write($path, $buffer, $offset)");
  my $length = length($buffer);
  return _write($path, $buffer, $offset);
}

sub _write
{
  my $path   = shift;
  my $buffer = shift;
  my $offset = shift || 0;
  syslog('info', "\t_write($path, $buffer, $offset)");
  my $length = length($buffer);
  my $local  = _local($path);
  my $body   = _read($path);
  substr($body, $offset, $length, $buffer);
  open(F, ">$local") || return 0;
  print F $body;
  close(F);
  return $length;
}

sub jd2_statfs
{
  syslog('info', "jd2_statfs()");
  return 0;
}

sub jd2_release
{
  my $path = shift;
  my $flag = shift;
  syslog('info', "jd2_release($path, $flag)");
  return _fsync($path, $flag);
}

sub jd2_fsync
{
  my $path = shift;
  my $flag = shift;
  syslog('info', "jd2_fsync($path, $flag)");
  return _fsync($path, $flag);
}

sub _fsync
{
  my $path = shift;
  my $flag = shift;
  syslog('info', "\t_fsync($path, $flag)");
  return 0 if !$flag;
  my $local  = _local($path);
  my $remote = _remote($path);
  return 0 if !-f $local;
  return -EIO() if !bucket_add_key_filename($remote, $local);
  _resize($path, -s $local);
  unlink($local);
  _reset($path);
  return 0;
}

sub _decrypt
{
  my $key = shift;
  return $key->{'value'};
}

sub jd2_flush
{
  my $path = shift;
  syslog('info', "jd2_flush($path)");
  return 0;
}

sub jd2_getxattr
{
  return -EOPNOTSUPP();
}

sub jd2_setxattr
{
  return -EOPNOTSUPP();
}

sub jd2_listxattr
{
  return -EOPNOTSUPP();
}

sub jd2_removexattr
{
  return -EOPNOTSUPP();
}

## CACHE

## BUCKET

sub bucket_add_key
{
  my $key = shift;
  syslog('info', "\tbucket->add_key($key)");
  $B{'add_key'}++;
  return $bucket->add_key($key, '', { 'Content-Length' => 0 });
}

sub bucket_add_key_filename
{
  my $key  = shift;
  my $file = shift;
  syslog('info', "\tbucket->add_key_filename($key, $file)");
  $B{'add_key_filename'}++;
  return $bucket->add_key_filename($key, $file);
}

sub bucket_delete_key
{
  my $key = shift;
  syslog('info', "\tbucket->delete_key($key)");
  $B{'delete_key'}++;
  return $bucket->delete_key($key);
}

sub bucket_rename_key
{
  my $old = shift;
  my $new = shift;

  bucket_add_key($new);
  bucket_delete_key($old);
}

sub bucket_get_key
{
  my $key = shift;
  syslog('info', "\tbucket->get_key($key)");
  $B{'get_key'}++;
  return $bucket->get_key($key);
}

sub bucket_list_all
{
  my $prefix = shift;
  syslog('info', "\tbucket->list_all($prefix)");
  $B{'list_all'}++;
  return $bucket->list_all({ prefix => $prefix });
}

sub array_key_exists
{
  my $key    = shift;
  my @array  = @_;
  my @search = (ref($array[0]) eq 'ARRAY') ? @{ $array[0] } : @array;
  map { return 1 if $_ eq $key; } (@search);
  return 0;
}

sub _attrkey
{
  my $path = shift;
  syslog('info', "\t_attrkey($path)");
  my $prefix = _prefix($path);
  return if !$prefix;
  my $keys = _list_all($prefix)->{'keys'};
  my @KEY;
  foreach my $_key (@$keys)
  {
    @KEY = split('/', $_key->{'key'});
    syslog('debug', "\t\t@KEY");
    last if (basename($path) eq encode_utf8($KEY[4]));
    @KEY = ();
  }
  return join('/', @KEY);
}

sub _nlink
{
  my $path  = shift;
  my $token = _token($path);
  my $nlink = scalar keys %{ $P{$token} };
  syslog('info', "\t\t_nlink($path) => $nlink");
  return $nlink;
}

# FUSE doesn't support inode
sub _inode
{
  my $path  = shift;
  my $token = _token($path);
  my $ino;
  my %M;
  my $s = 2;
  my $i = 0;
  my $j = 0;
  map { $M{$_} = $i++; } (0 .. 9, 'a' .. 'f');
  map { $ino += $M{$_} * $s**$j++; } (reverse split(//, $token));
  syslog('info', "\t\t_inode($path) => $ino");
  return $ino;
}
